;;;; -*- Mode: Lisp; Package: dreaming-tree; -*-

(in-package :lui)

(objc:defmethod (#/keyUp: :void) ((self native-window) event)
  (view-event-handler (lui-window Self)
                      (make-instance 'key-event 
                        :key-code (#/keyCode Event)
                        :event-type (native-to-lui-event-type (#/type event))
                        :native-event Event)))

(in-package :dreaming-tree)

(defclass xlui-renderer (opengl-dialog renderer)
  ())

(defmethod prepare-opengl  ((view xlui-renderer))
  ;; Back facing polygons are filled, while front facing are only outlined.
  ;; Apparently this is a setting of "personal preference" and the topic is more
  ;; fully discussedin the Red Book.
  (glShadeModel GL_SMOOTH)
  (glEnable GL_TEXTURE_2D)
  (glClearColor 0.0 0.0 0.0 0.5)
  (glClearDepth 1.0d0)
  (glEnable GL_DEPTH_TEST)
  (glDepthFunc GL_LEQUAL)
  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST))

(defmethod initialize-instance :after ((view xlui-renderer) &rest initargs)
  (declare (ignore initargs))
  (setf (camera view) (make-instance 'action-camera)
	(culling-camera (scene-culler view)) (camera view)))

(defmethod KEY-EVENT-HANDLER ((View lui::window) Event)
  (lui::do-subviews (subview view)
    (key-event-handler subview event)))

(defmethod key-event-handler ((View xlui-renderer) (Event key-event))
  (let ((*Current-key-Event* Event))
    (with-simple-restart (abandon-view-event-handler "Stop event handling of event ~S of window ~S" Event View)
      (setf (current-key-event view) event)
      (unless (is-animated view) (display view))))) ; w

(defmethod view-left-mouse-down-event-handler ((view xlui-renderer) x y) 
  (declare (ignore X Y))
  ;(format t "down: ~A, ~A~%" x y)
  (setf (culler-update-p view) t)
  (unless (is-animated view) (display view)))

(defmethod view-left-mouse-dragged-event-handler ((view xlui-renderer) x y dx dy)
  (declare (ignore X Y))
  ;(format t "dragged: ~A ~A~%" dx dy)
  (turn view dx dy)
  (setf (culler-update-p view) t)
  (unless (is-animated view) (display view)))

(defmethod set-size :after ((view xlui-renderer) width height)
  (lui::in-main-thread ()
    (with-glcontext View
      (glflush)
      ;(format t "Resize event (~A, ~A)~%" width height)
      (glViewport 0 0 Width Height)
      (when (camera View)
	(setf (camera-aspect (camera view)) (float (/ Width Height) 0.0d0))))))

(defparameter *app* nil)
(defparameter *view* nil)

(defmethod move-camera ((view renderer))
  (with-slots (current-key-event) view
    (when current-key-event
      (if (eql (lui::event-type current-key-event) :key-down)
	  (case (key-code current-key-event)
	    (0 (move-left view)) ; a
	    (1 (move-back view)) ; s
	    (2 (move-right view)) ; d
	    (13 (move-forward view))
	    (116 (move-up view)) ; page up
	    (121 (move-down view)) ; page down
	    (123 (turn-left view))
	    (124 (turn-right view))
	    (125 (look-down view))
	    (126 (look-up view))
	    (t (format t "Unrecognized key code ~A." (key-code current-key-event))))) ; w
      (setf (culler-update-p view) t))))

(defmethod animate ((view xlui-renderer) delta)
  (setf (current-timestep view) delta))

(defmethod application-time ((view xlui-renderer))
  (lui::animation-time view))

(defmethod draw ((view xlui-renderer))
  ;(format t "xlui-renderer draw event.~%")
  (on-idle view))

(defmethod draw-scene ((canvas xlui-renderer) objects)
  (dolist (o objects)
    (draw o)))


(defun test-scene (&optional (scene (cube-scene)))
  (setq *app* (slui (:application-window :title "Scene" :width 640 :height 480
					 (:xlui-renderer :name "Renderer"))))
  (setq *view* (view-named *app* "Renderer"))
  (setf (renderer-scene-root *view*) scene))

;;;; Drawing Geometric Primitives ;;;;

(defun map-lisp-type-to-gl (type)
  (case type
    (double-float GL_DOUBLE)
    (single-float GL_FLOAT)))

;; Use aux:with-gensyms
(defmacro with-world-transformation (spatial &body body)
  `(let ((m (transform ,spatial)))
     (with-slots (r s b) m
       (glPushMatrix)
       (gltranslatef (x b) (y b) (z b))
       (glscalef (x s) (y s) (z s))
       (multiple-value-bind (angle dir) (quat-to-axis-angle r)
	 (glrotatef (lib.gl::rad-to-deg angle) (x dir) (y dir) (z dir))))
     ,@body
     (glPopMatrix)))

;; Not much for the moment, but will eventually involve the use of buffer arrays.
(defmacro with-i-buffer (geometry &body body)
  (declare (ignore geometry))
  `(progn
     ,@body))

;; Likewise, not much until I understand better how I want to implement render states.
(defmacro with-global-states (geometry &body body)
  (declare (ignore geometry))
  `(progn
     ,@body))

(defmethod draw ((g geometry))
  ;; Set global state?
  (with-world-transformation g
    (with-i-buffer g
      (draw-elements g))))

(defmethod draw-elements ((obj trimesh))
  (ccl:rlet ((zoffset :<GL>uint))
    (setf (ccl:%get-unsigned-byte zoffset) 0)
    (with-slots (v vid c cid n nid i iid tc tcid) obj
      ;; Draw vertices
      (when (or (slot-boundp obj 'v) vid)
	(format t "About to draw vertices.~%")
	(glEnableClientState GL_VERTEX_ARRAY)
	(if vid
	    (progn
	      (glBindBufferARB GL_ARRAY_BUFFER_ARB vid)
	      (glVertexPointer 3 (map-lisp-type-to-gl (element-type v)) 0 zoffset))
	    (glVertexPointer 3 (map-lisp-type-to-gl (element-type v)) 0 (get-pointer v))))
      ;; (when (or (slot-boundp obj 'c) cid)
      ;; 	(format t "About to draw colors.~%")
      ;; 	(glEnableClientState GL_COLOR_ARRAY)
      ;; 	(if cid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB cid)
      ;; 	      (glColorPointer 3 (map-lisp-type-to-gl (element-type c)) 0 zoffset))
      ;; 	    (glColorPointer 3 (map-lisp-type-to-gl (element-type c)) 0 (get-pointer c))))
      ;; (when (or (slot-boundp obj 'n) nid)
      ;; 	(format t "About to draw normals.~%")
      ;; 	(glEnableClientState GL_NORMAL_ARRAY)
      ;; 	(if nid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB nid)
      ;; 	      (glNormalPointer (map-lisp-type-to-gl (element-type n)) 0 zoffset))
      ;; 	    (glNormalPointer (map-lisp-type-to-gl (element-type n)) 0 (get-pointer n))))
      ;; (when (or (slot-boundp obj 'tc) tcid)
      ;; 	(format t "About to draw texture coordinates.~%")
      ;; 	(glEnableClientState GL_TEXTURE_COORD_ARRAY)
      ;; 	(if tcid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB nid)
      ;; 	      (glTexCoordPointer 3 (map-lisp-type-to-gl (element-type tc)) 0 zoffset))
      ;; 	    (glTexCoordPointer 2 (map-lisp-type-to-gl (element-type tc)) 0 (get-pointer tc))))
      (format t "About to put it al together!~%")
      (if iid
	  (progn
	    (glBindBufferARB GL_ELEMENT_ARRAY_BUFFER iid)
	    (glDrawElements GL_TRIANGLES (element-count i) GL_UNSIGNED_INT zoffset))
	  (glDrawElements GL_TRIANGLES (element-count i) GL_UNSIGNED_INT (get-pointer i)))
      ;;(glDrawArrays GL_POINTS 0 (lib.gl::element-count v))
      (glDisableClientState GL_TEXTURE_COORD_ARRAY)
      (glDisableClientState GL_NORMAL_ARRAY)
      (glDisableClientState GL_COLOR_ARRAY)
      (glDisableClientState GL_VERTEX_ARRAY))))
